PD ROM 1/PD ROM Volume I - Macintosh Software from BMUG (1988).iso/Stacks/Hyper Utilities/XCMD's⁄XFCN's/SortXFCN/SortXFCN.p

Text File | 1988-01-09 | 10.1 KB | 297 lines | [TEXT/ttxt]

{[n+,u+,r+,d+,#+,j=13-/40/1o,t=2,o=95] PasMat formatting options}
{------------------------------------------------------------------------------

FILE SortXFCN.p

NAME
  SortXFCN

DESCRIPTION
 This HyperCard external function sorts numerically the contents of the field
 passed as the single parameter.  This field should contain numbers (signed
 reals or integers) separated by spaces.  A typical invocation of the function
 would be:
   Put SortRealsII( inputField ) into outputField

 To compile and link using Macintosh Programmer's Workshop 2.0 execute
 the accompanying make file.  This code contains compiler directives to write
 code using the 68881 coprocessor and the 68020 processor.  This results in a
 considerable speed increase on a Mac II.  Remove these directives before
 compiling for other machines.

------------------------------------------------------------------------------}
{$R-}                                  { Turn off range checking }
{$MC68881+}                            { Generate 68881 code }
{$S SortRealsII }

UNIT SortXFCN;

  {------------------------------------------------------------------------------}
  {----------------------------  INTERFACE Section  -----------------------------}
  {------------------------------------------------------------------------------}

  INTERFACE

    {------------------------------------------------------------------------------}
    {------------------------------------------------------------------------------}

    USES Memtypes, Quickdraw, OSIntf, ToolIntf, HyperXCmd;

    PROCEDURE EntryPoint(paramPtr: XCmdPtr);

    {------------------------------------------------------------------------------}
    {-------------------------  IMPLEMENTATION Section  ---------------------------}
    {------------------------------------------------------------------------------}

  IMPLEMENTATION

    {------------------------------------------------------------------------------}
    {------------------------------------------------------------------------------}

    PROCEDURE SortRealsII(paramPtr: XCmdPtr);
      FORWARD;

    {------------------------------------------------------------------------------}

    PROCEDURE EntryPoint(paramPtr: XCmdPtr);

      BEGIN
        SortRealsII(paramPtr)
      END                              { entrypoint } ;

    {------------------------------------------------------------------------------}

    PROCEDURE SortRealsII;

    {$MC68020+}                        { Generate 68020 code }

      TYPE
        ListPtr      = ^ListInfo;            { Use a linked list to sort the numbers }
        ListInfo     = RECORD
                         str: Str31;    { Keep both string and real forms so that we only }
                         num: Real;        { have to do one conversion between forms. }
                         next: ListPtr;
                       END;

      VAR
                err: OSErr;
        realNumList: ListPtr;

      {$I XCmdGlue.inc}

        {------------------------------------------------------------------------------}

      PROCEDURE SkipSpaces(VAR thePtr: Ptr);

        VAR
          pos:         Integer;

        BEGIN
          WHILE Chr(thePtr^) = ' ' DO
            BEGIN
              thePtr := Ptr(Ord4(thePtr) + 1);
            END;
        END;

      {------------------------------------------------------------------------------}

      FUNCTION NextToken(VAR thePtr: Ptr): Str31;
      { Entry conditions :    thePtr points to a memory block which is terminated }
      {                                            with a zero byte.  }
      { Exit conditions :        Any leading spaces are stripped and up to 31 of the }
      {                                            following characters are collected in a Pascal string. }
      {                                            The string is terminated with less than 31 charaters }
            {                                            when a space or the zero byte is encountered after }
      {                                            which thePtr points to that terminating char/byte. }

        VAR
          pos:         Integer;
          xferStr:     Str31;

        BEGIN
          SkipSpaces(thePtr);
          NextToken := '';
          pos := 0;
          WHILE (thePtr^ <> $00) & (thePtr^ <> $20) & (pos < 31) DO
            BEGIN
              pos := pos + 1;
              xferStr[pos] := Chr(thePtr^);            { Put next character into string }
              thePtr := Ptr(Ord4(thePtr) + 1);    { and advance the pointer. }
            END;
          xferStr[0] := Chr(pos);                                { Set the string length. }
          NextToken := xferStr;
        END;

      {------------------------------------------------------------------------------}

      FUNCTION StringToReal(str: Str31): Real;
      { Entry conditions :    str is a valid string representation of a signed real }
      {                                            containing only digits, '.', and optionally '+' or '-'. }

        VAR
          i, decPos, startPos, sign: Integer;
          tempReal, fraction: Real;

        BEGIN
          tempReal := 0;
          decPos := pos('.', str);
          IF str[1] IN ['-', '+'] THEN
            startPos := 2
          ELSE
            startPos := 1;
          IF str[1] = '-' THEN
            sign := - 1
          ELSE
            sign := + 1;
          IF decPos = 0 THEN decPos := Length(str) + 1;
          FOR i := startPos TO decPos - 1 DO
            tempReal := 10 * tempReal + Ord(str[i]) - Ord('0');
          fraction := 0;
          FOR i := Length(str) DOWNTO decPos + 1 DO
            fraction := (fraction + Ord(str[i]) - Ord('0')) / 10;
          StringToReal := sign * (tempReal + fraction);
        END;

      {------------------------------------------------------------------------------}

      PROCEDURE BuildList(VAR firstElement: ListPtr; inputHandle: Handle);
            { Build a list from the Handle to the zero-terminated data structure containing }
            { the list of numbers represented in ASCII form and separated by spaces. }

        VAR
            inputFldPtr: Ptr;
          curElement, prevElement: ListPtr;
          numStr:      Str31;

        BEGIN
          curElement := ListPtr(NewPtr(SizeOf(ListInfo)));
          prevElement := NIL;
          firstElement := curElement;
          curElement^.next := NIL;
                    HLock(inputHandle);
                    inputFldPtr := inputHandle^;
          numStr := NextToken(inputFldPtr);
          WHILE numStr <> '' DO
            BEGIN
              curElement^.num := StringToReal(numStr);
              curElement^.str := numStr;
              prevElement := curElement;
              curElement := ListPtr(NewPtr(SizeOf(ListInfo)));
              prevElement^.next := curElement;
              numStr := NextToken(inputFldPtr);
            END;
                    HUnlock(inputHandle);
          DisposPtr(Ptr(curElement));
          IF prevElement <> NIL THEN
            prevElement^.next := NIL
          ELSE
            firstElement := NIL;
        END;

      {------------------------------------------------------------------------------}

      PROCEDURE SwapInfo(ptr1, ptr2: ListPtr);
            { Just as easy to swap info as switch pointers around }

        VAR
          num:         Real;
          numStr:      Str31;

        BEGIN
          num := ptr1^.num;
          numStr := ptr1^.str;
          ptr1^.num := ptr2^.num;
          ptr1^.str := ptr2^.str;
          ptr2^.num := num;
          ptr2^.str := numStr;
        END;

      {------------------------------------------------------------------------------}

      PROCEDURE SortList(VAR theList: ListPtr);
            { An awkward sort of selection sort }

        VAR
          small:       Real;
          insidePtr, outsidePtr, smallPtr: ListPtr;

        BEGIN
          outsidePtr := theList;
          IF theList <> NIL THEN
            WHILE outsidePtr^.next <> NIL DO
              BEGIN
                insidePtr := outsidePtr^.next;
                smallPtr := outsidePtr;
                small := smallPtr^.num;
                WHILE insidePtr <> NIL DO
                  BEGIN
                    IF insidePtr^.num < small THEN
                      BEGIN
                        smallPtr := insidePtr;
                        small := smallPtr^.num;
                      END;
                    insidePtr := insidePtr^.next;
                  END;
                SwapInfo(smallPtr, outsidePtr);
                outsidePtr := outsidePtr^.next;
              END;

        END;

      {------------------------------------------------------------------------------}

      PROCEDURE ListToHandle(numList: ListPtr; VAR theHandle: Handle);
            { Obtain a Handle to a zero-terminated data structure containing the sorted }
            { list represented in ASCII form and separated by spaces. }

        VAR
          spacePtr, zeroPtr, tempPtr: Ptr;
          err:         OSErr;
          space, zero: SignedByte;

        BEGIN
          space := $20;
          zero := $00;
          theHandle := NewHandle(0);
          WHILE numList <> NIL DO
            BEGIN
              tempPtr := Ptr(Ord4(@numList^.str) + 1);        { Point to first char in string and }
                                                                                                                    { append characters to theHandle^^ }
                             err := PtrAndHand(tempPtr, theHandle, Length(numList^.str));
              numList := numList^.next;
              IF numList <> NIL THEN                                           { If it's not the last number in }
                err := PtrAndHand(@space, theHandle, 1);    { the list then append a space. }
            END;
          err := PtrAndHand(@zero, theHandle, 1);                    { Terminate with 0 byte }
        END;

      {------------------------------------------------------------------------------}

      PROCEDURE DisposeList(VAR theList: ListPtr);

        VAR
          tempPtr:     ListPtr;

        BEGIN
          tempPtr := theList;
          WHILE tempPtr <> NIL DO
            BEGIN
              tempPtr := theList^.next;
              DisposPtr(Ptr(theList));
              theList := tempPtr;
            END;
        END;

      {------------------------------------------------------------------------------}
      {-------------------------  PROCEDURE SortRealsII  ----------------------------}
      {------------------------------------------------------------------------------}

      BEGIN
        BuildList(realNumList, paramPtr^.Params[1]);
        SortList(realNumList);
        ListToHandle(realNumList, paramPtr^.returnValue);
        DisposeList(realNumList);
      END;

END.